home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / opc.mod (.txt) < prev    next >
Oberon Text  |  1996-06-09  |  59KB  |  1,856 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. Syntax10b.Scn.Fnt
  5. (* Notify Ralf for maintenance of Non-FPU source *)
  6. MODULE OPC;
  7. (* Code Generator for MC68020.
  8.  Diplomarbeit Samuel Urech
  9.  Date: 6.11.92   Current version: 26.2.93
  10.  Bug concerning record assignment (projection) in Convert fixed by cn/shml 30 Jun 94
  11.  Nil-Check by rd/cn 22.05.95 *)
  12.  IMPORT SYSTEM, OPT, OPL, OPM;
  13.  CONST
  14.   (* object modes *)
  15.   Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  16.   SProc = 8; CProc = 9; IProc = 10; Head = 12; TProc = 13;
  17.   (* accessibility of objects *)
  18.   internal = 0; external = 1; externalR = 2;
  19.   (* structure forms *)
  20.   Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  21.   Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  22.   Pointer = 13; ProcTyp = 14; Comp = 15;
  23.   (* composite structure forms *)
  24.   Basic = 1; Array = 2; DynArr = 3; Record = 4;
  25.   IntSet = { SInt .. LInt };
  26.   RealSet = { Real, LReal };
  27.   ByteSet = { SInt, Byte, Char, Bool };
  28.   WordSet = { Int };
  29.   LongSet = { LInt, Set, Pointer, ProcTyp };
  30.   (* item modes *)
  31.   dreg = 0; areg = 1; freg = 2; postinc = 3; predec = 4; regx = 5; abs = 7; imm = 8; immL = 9; pcx = 10; coc = 12; fcoc = 13;
  32.   (* sizes *)
  33.   byte = 0; word = 1; long = 2;
  34.   (* opcodes *)
  35.   ADD = 13; AND = 12; oR = 8; SUB = 9;
  36.   BCHG = 1; BCLR = 2; BSET = 3; BTST = 0;
  37.   ADDI = 6; ANDI = 2; CMPI = 12; EORI = 10; ORI = 0; SUBI = 4;
  38.   ADDQ = 0; SUBQ = 1;
  39.   CLR = 2; NEG = 4; NEGX = 0; NOT = 6; TST = 10;
  40.   BFCHG = 10; BFCLR = 12; BFSET = 14; BFTST = 8;
  41.   DIVS = 81C0H; DIVU = 80C0H; MULS = 0C1C0H; MULU = 0C0C0H;
  42.   ASh = 0; LSh = 1; ROt = 3; ROX = 2;
  43.   JMP = 3BH; JSR = 3AH; PEA = 21H; NBCD = 20H; TAS = 2BH;
  44.   (* Coprocessor opcodes *)
  45.   FABS = 18H; FACOS = 1CH; FADD = 22H; FASIN = 0CH; FATAN = 0AH; FATANH = 0DH; FCMP = 38H;
  46.   FCOS = 1DH; FCOSH = 19H; FDIV = 20H; FETOX = 10H; FETOXM1 = 8; FGETEXP = 1EH; FGETMAN = 1FH;
  47.   FINT = 1; FINTRZ = 3; FLOG10 = 15H; FLOG2 = 16H; FLOGN = 14H; FLOGNP1 = 6; FMOD = 21H; FMOVE = 0;
  48.   FMUL = 23H; FNEG = 1AH; FREM = 25H; FSCALE = 26H; FSGLDIV = 24H; FSGLMUL = 27H; FSIN = 0EH;
  49.   FSINH = 2; FSQRT = 4; FSUB = 28H; FTAN = 0FH; FTANH = 9; FTENTOX = 12H; FTST = 3AH; FTWOTOX = 11H;
  50.   (* Compare kinds *)
  51.   eql = 9; neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  52.   (* Condition Codes *)
  53.   CC = 4; CS = 5; EQ = 7; false = 1; GE = 12; GT = 14; HI = 2; LE = 15;
  54.   LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; true = 0; VC = 8; VS = 9;
  55.   (* Floating Point Condition Codes *)
  56.   FEQ = 1; FNE = 0EH; FGT = 12H; FNGT = 1DH; FGE = 13H; FNGE = 1CH; FLT = 14H; FNLT = 1BH; FLE = 15H;
  57.   FNLE = 1AH; Ffalse = 0; Ftrue = 0FH;
  58.   (* Floating Point Control Registers *)
  59.   FPCR = 4; FPSR = 2; FPIAR = 1;
  60.   (* Traps, not used ? *)
  61.   inxTrap = 8; rngTrap = 9; guardTrap = 18; eqGuardTrap = 19;
  62.   super = 1;
  63.   None = -1;
  64.  VAR FP, SP : OPL.Item;
  65.    indexCheck, rangeCheck, nilCheck, ptrinit, saveRegs* : BOOLEAN;
  66.  PROCEDURE Init*( options : SET );
  67.  BEGIN
  68.   indexCheck := 0 IN options;
  69.   rangeCheck := 2 IN options;
  70.   nilCheck := 9 IN options;
  71.   ptrinit := 5 IN options
  72.  END Init;
  73.  PROCEDURE MakeLen*( VAR arr : OPL.Item; n : LONGINT; VAR item : OPL.Item );
  74.  (* Makes an item that denotes the length in the n-th dimension of a dynamic array. *)
  75.  BEGIN (* MakeLen *)
  76.   item := arr;
  77.   IF item.nolen = 0 THEN
  78.    item.bd := arr.bd + 4 * ( n + 1 )
  79.   ELSE
  80.    item.bd := arr.bd + 4 * n
  81.   END; (* IF *)
  82.   item.typ := OPT.linttyp
  83.  END MakeLen;
  84.  PROCEDURE MakeIntConst*( val : LONGINT; typ : OPT.Struct; VAR item : OPL.Item );
  85.  (* Makes an immediate item of a given type from a number. *)
  86.  BEGIN (* MakeIntConst *)
  87.   item.mode := imm;
  88.   item.typ := typ;
  89.   item.bd := val
  90.  END MakeIntConst;
  91.  PROCEDURE MakeVar*( obj : OPT.Object; VAR item : OPL.Item );
  92.  (* Makes an item from a variable. *)
  93.   VAR aregItem : OPL.Item;
  94.   PROCEDURE GetVarBase( obj : OPT.Object ) : INTEGER;
  95.   (* Returns the register to which the given variable is relative. *)
  96.    VAR diff, reg : INTEGER;
  97.      source, dest : OPL.Item;
  98.   BEGIN (* GetVarBase *)
  99.    diff := OPL.level - obj.mnolev;
  100.    IF diff = 0 THEN
  101.     reg := FP.reg
  102.    ELSE (* follow static link *)
  103.     reg := OPL.GetAdrReg( );
  104.     source.mode := regx;
  105.     source.typ := OPT.sysptrtyp;
  106.     source.reg := FP.reg;
  107.     source.bd := 8;
  108.     source.inxReg := None;
  109.     source.offsReg := None;
  110.     dest.mode := areg;
  111.     dest.typ := OPT.sysptrtyp;
  112.     dest.reg := reg;
  113.     OPL.Move( source, dest );
  114.     source.reg := reg;
  115.     WHILE diff > 1 DO
  116.      OPL.Move( source, dest );
  117.      DEC( diff )
  118.     END; (* WHILE *)
  119.    END; (* IF *)
  120.    RETURN reg
  121.   END GetVarBase;
  122.  BEGIN (* MakeVar *)
  123.   IF ( obj.mode = VarPar ) & ( obj.typ.comp # DynArr ) THEN
  124.    item.mode := regx;
  125.    item.reg := GetVarBase( obj );
  126.    item.typ := OPT.sysptrtyp;
  127.    item.bd := obj.adr;
  128.    item.inxReg := None;
  129.    aregItem.mode := areg;
  130.    aregItem.reg := OPL.GetAdrReg( );
  131.    OPL.Move( item, aregItem );
  132.    OPL.FreeReg( item );
  133.    item.mode := regx;
  134.    item.reg := aregItem.reg;
  135.    item.bd := 0
  136.   ELSIF obj.mnolev < 0 THEN (* imported variable *)
  137.    item.mode := abs;
  138.    item.bd := SYSTEM.LSH( LONG( LONG( -obj.mnolev ) ), 8 ) + obj.adr
  139.   ELSIF obj.mnolev = 0 THEN (* global variable *)
  140.    item.mode := pcx;
  141.    item.bd := obj.linkadr
  142.   ELSE (* local variable *)
  143.    item.mode := regx;
  144.    item.reg := GetVarBase( obj );
  145.    item.bd := obj.adr
  146.   END; (* IF *)
  147.   item.typ := obj.typ;
  148.   item.inxReg := None;
  149.   item.offsReg := None;
  150.   item.nolen := 0
  151.  END MakeVar;
  152.  PROCEDURE DeRef*( typ : OPT.Struct; VAR item : OPL.Item );
  153.  (* Makes a dereferentiation of an item. *)
  154.   VAR aregItem, dregItem : OPL.Item;
  155.     inxReg : INTEGER;
  156.  BEGIN (* DeRef *)
  157.   aregItem.mode := areg;
  158.   (* If item is (Ax) with x<6, use Ax again *)
  159.   IF saveRegs & (item.mode=regx) & (item.reg<14) THEN
  160.       aregItem.reg:=item.reg
  161.   ELSE
  162.       aregItem.reg := OPL.GetAdrReg( )
  163.   END;
  164.   item.typ := OPT.sysptrtyp;
  165.   inxReg := item.offsReg;
  166.   OPL.Move( item, aregItem );
  167.   IF nilCheck & (~(item.mode=immL)) THEN
  168.    dregItem.mode:=dreg;
  169.    dregItem.reg:=OPL.GetReg();
  170.    NEW(aregItem.typ);aregItem.typ.size:=4;
  171.    OPL.Move( aregItem, dregItem);
  172.    OPL.Trapcc(EQ, 2);
  173.    OPL.FreeReg(dregItem)
  174.   END;
  175.   item.mode := regx;
  176.   item.typ := typ;
  177.   item.reg := aregItem.reg;
  178.   item.bd := 0;
  179.   item.inxReg := inxReg; (* xsize and scale keep their values *)
  180.   IF typ.comp = DynArr THEN
  181.    item.nolen := SHORT( typ.n ) + 1
  182.   ELSE
  183.    item.nolen := 0
  184.   END; (* IF *)
  185.  END DeRef;
  186.  PROCEDURE StaticTag*( typ : OPT.Struct; VAR tag : OPL.Item );
  187.  (* Returns the type tag of a type. *)
  188.  BEGIN (* StaticTag *)
  189.   tag.mode := immL;
  190.   tag.typ := OPT.sysptrtyp;
  191.   tag.bd := SYSTEM.LSH( LONG( LONG( typ.mno ) ), 8 ) + typ.tdadr
  192.  END StaticTag;
  193.  PROCEDURE MakeTag*( obj : OPT.Object; typ : OPT.Struct; VAR item, tag : OPL.Item );
  194.  (* Makes an item that denotes the type tag of the given object and item. *)
  195.  BEGIN (* MakeTag *)
  196.   IF item.typ.form = Pointer THEN
  197.    tag := item;
  198.    DeRef( OPT.sysptrtyp, tag );
  199.    tag.bd := -4
  200.   ELSIF ( obj # NIL ) & ( obj.mode = VarPar ) THEN
  201.    tag.mode := regx;
  202.    tag.typ := OPT.sysptrtyp;
  203.    tag.reg := FP.reg;
  204.    tag.bd := obj.adr + 4;
  205.    tag.inxReg := None;
  206.    tag.offsReg := None
  207.   ELSE
  208.    StaticTag( typ, tag )
  209.   END; (* IF *)
  210.  END MakeTag;
  211.  PROCEDURE MakeConst*( obj : OPT.Object; const : OPT.Const; typ : OPT.Struct; VAR item : OPL.Item );
  212.  (* Makes an item from a constant. *)
  213.   VAR realval : REAL;
  214.  BEGIN (* MakeConst *)
  215.   item.typ := typ;
  216.   CASE typ.form OF
  217.    Set :
  218.     MakeIntConst( SYSTEM.VAL( LONGINT, const.setval ), typ, item )
  219.    | String :
  220.     OPL.AllocConst( obj, typ, const.ext^, const.intval2, item );
  221.     item.nolen := SHORT( const.intval2 )
  222.    | Real :
  223.     realval :=  SHORT( const.realval );
  224.     OPL.AllocConst( obj, typ, realval, 4, item )
  225.    | LReal :
  226.     OPL.AllocConst( obj, typ, const.realval, 8, item )
  227.   ELSE
  228.    MakeIntConst( const.intval, typ, item )
  229.   END; (* CASE *)
  230.  END MakeConst;
  231.  PROCEDURE BaseTypSize( VAR arr, size : OPL.Item; VAR scale : INTEGER );
  232.  (* Returns the size of the base type of a dynamic array if the base type is a dynamic array itself. *)
  233.   VAR i : LONGINT;
  234.     typ : OPT.Struct;
  235.     len : OPL.Item;
  236.  BEGIN (* BaseTypSize *)
  237.   typ := arr.typ.BaseTyp;
  238.   WHILE typ.comp = DynArr DO
  239.    typ := typ.BaseTyp
  240.   END; (* WHILE *)
  241.   IF ( typ.size = 1 ) OR ( typ.size = 2 ) OR ( typ.size = 4 ) OR ( typ.size = 8 ) THEN
  242.    scale := SHORT( typ.size );
  243.    MakeLen( arr, arr.typ.offset, size )
  244.   ELSE
  245.    scale := 1;
  246.    MakeIntConst( typ.size, OPT.linttyp, size );
  247.    MakeLen( arr, arr.typ.offset, len );
  248.    OPL.Format12( MULS, len, size );
  249.    OPL.FreeReg( len )
  250.   END; (* IF *)
  251.   FOR i := arr.typ.offset - arr.typ.n + 1 TO arr.typ.offset - 1 DO
  252.    MakeLen( arr, i, len );
  253.    OPL.Format12( MULS, len, size );
  254.    OPL.FreeReg( len )
  255.   END; (* FOR *)
  256.  END BaseTypSize;
  257.  PROCEDURE Size( VAR arr, size : OPL.Item; VAR scale : INTEGER );
  258.  (* Returns the size of a dynamic array and a scale factor. *)
  259.   VAR len : OPL.Item;
  260.     typ : OPT.Struct;
  261.  BEGIN (* Size *)
  262.   MakeLen( arr, arr.typ.offset - arr.typ.n, len );
  263.   typ := arr.typ.BaseTyp;
  264.   IF typ.comp = DynArr THEN
  265.    BaseTypSize( arr, size, scale );
  266.    OPL.Format12( MULS, len, size );
  267.    OPL.FreeReg( len )
  268.   ELSE
  269.    IF ( typ.size = 1 ) OR ( typ.size = 2 ) OR ( typ.size = 4 ) OR ( typ.size = 8 ) THEN
  270.     scale := SHORT( typ.size );
  271.     size := len
  272.    ELSE
  273.     scale := 1;
  274.     MakeIntConst( typ.size, OPT.linttyp, size );
  275.     OPL.Format12( MULS, len, size );
  276.     OPL.FreeReg( len )
  277.    END; (* IF *)
  278.   END; (* IF *)
  279.  END Size;
  280.  PROCEDURE ElimIndex( VAR item : OPL.Item );
  281.  (* Eliminates the index register in the item. *)
  282.   VAR newReg : INTEGER;
  283.  BEGIN (* ElimIndex *)
  284.   IF item.inxReg # None THEN (* load old address *)
  285.    newReg := OPL.GetAdrReg( );
  286.    OPL.Lea( item, newReg );
  287.    item.mode := regx;
  288.    item.bd := 0;
  289.    item.reg := newReg;
  290.    item.inxReg := None
  291.   END; (* IF *)
  292.  END ElimIndex;
  293.  PROCEDURE SetElem*( VAR item : OPL.Item );
  294.  (* Makes a set-element from an integer element and sets the corresponding bit. *)
  295.   VAR source : OPL.Item;
  296.  BEGIN (* SetElem *)
  297.   source :=  item;
  298.   item.mode := dreg;
  299.   item.typ := OPT.settyp;
  300.   item.reg := OPL.GetReg( );
  301.   OPL.Format7( CLR, item );
  302.   OPL.Format5( BSET, source, item )
  303.  END SetElem;
  304.  PROCEDURE RoundDown;
  305.  (* Sets the rounding mode of the coprocessor to -inf. *)
  306.   VAR temp : OPL.Item;
  307.  BEGIN (* RoundDown *)
  308.   MakeIntConst( 20H, OPT.linttyp, temp );
  309.   OPL.FMovecr( temp, 0, FPCR )
  310.  END RoundDown;
  311.  PROCEDURE RoundNearest;
  312.  (* Sets the rounding mode of the coprocessor to nearest. *)
  313.   VAR temp : OPL.Item;
  314.  BEGIN (* RoundNearest *)
  315.   MakeIntConst( 0, OPT.linttyp, temp );
  316.   OPL.FMovecr( temp, 0, FPCR )
  317.  END RoundNearest;
  318.  PROCEDURE Convert*( VAR source : OPL.Item; desttyp : OPT.Struct );
  319.  (* Converts the given item to desttyp. *)
  320.   VAR sf, sc, df, dc : SHORTINT;
  321.     dest : OPL.Item;
  322.  BEGIN (* Convert *)
  323.   sf := source.typ.form;
  324.   sc := source.typ.comp;
  325.   df := desttyp.form;
  326.   dc := desttyp.comp;
  327.   IF df = ProcTyp THEN (* handles assignments of functions to proc vars *) source.typ := desttyp; RETURN END;
  328.   IF (df = Comp) & (sf = Comp) & (dc = Record) & (sc = Record) THEN
  329.     (* handles record assignment including projection *)
  330.    source.typ := desttyp;
  331.    RETURN
  332.   END;
  333.   IF ( sf # Pointer ) & ( ( sf # df ) OR ( sc # dc ) ) THEN
  334.    IF df IN LongSet THEN
  335.     IF sf = Char THEN
  336.      dest.mode := dreg;
  337.      dest.typ := desttyp;
  338.      dest.reg := OPL.GetReg( );
  339.      OPL.Format7( CLR, dest );
  340.      OPL.Move( source, dest );
  341.      source := dest
  342.     ELSIF sf IN ByteSet + WordSet THEN
  343.      OPL.Ext( source, long )
  344.     ELSIF sf IN RealSet THEN
  345.      OPL.FLoad( source );
  346.      RoundDown;
  347.      source.typ := desttyp;
  348.      OPL.Load( source );
  349.      RoundNearest
  350.     END; (* IF *)
  351.    ELSIF df IN WordSet THEN
  352.     IF sf IN LongSet THEN
  353.      OPL.Load( source )
  354.     ELSIF sf = Char THEN
  355.      dest.mode := dreg;
  356.      dest.typ := desttyp;
  357.      dest.reg := OPL.GetReg( );
  358.      OPL.Format7( CLR, dest );
  359.      OPL.Move( source, dest );
  360.      source := dest
  361.     ELSIF sf IN ByteSet THEN
  362.      OPL.Ext( source, word )
  363.     ELSIF sf IN RealSet THEN
  364.      OPL.FLoad( source );
  365.      RoundDown;
  366.      source.typ := desttyp;
  367.      OPL.Load( source );
  368.      RoundNearest
  369.     END; (* IF *)
  370.    ELSIF df IN ByteSet THEN
  371.     IF sf IN WordSet + LongSet THEN
  372.      OPL.Load( source )
  373.     ELSIF sf IN RealSet THEN
  374.      OPL.FLoad( source );
  375.      RoundDown;
  376.      source.typ := desttyp;
  377.      OPL.Load( source );
  378.      RoundNearest
  379.     END; (* IF *)
  380.    ELSIF df IN RealSet THEN
  381.     OPL.FLoad( source )
  382.    END; (* IF *)
  383.    source.typ := desttyp
  384.   END; (* IF *)
  385.  END Convert;
  386.  PROCEDURE GetDynArrVal*( VAR item : OPL.Item );
  387.  (* Returns an item containing the actual value of a dynamic array. *)
  388.  BEGIN (* GetDynArrVal *)
  389.   IF item.nolen = 0 THEN
  390.    DeRef( OPT.sysptrtyp, item )
  391.   ELSE
  392.    INC( item.bd, LONG( item.nolen ) * 4 );
  393.    item.nolen := 0;
  394.    item.typ := OPT.sysptrtyp;
  395.    item.inxReg := item.offsReg;
  396.    item.offsReg := None
  397.   END; (* IF *)
  398.  END GetDynArrVal;
  399.  PROCEDURE GetDynArrAdr( VAR item, adr : OPL.Item );
  400.  (* Returns an item containing the address of a dynamic array. *)
  401.   VAR adrReg : OPL.Item;
  402.  BEGIN (* GetDynArrAdr *)
  403.   adr.typ := OPT.sysptrtyp;
  404.   adr.nolen := 0;
  405.   IF item.nolen = 0 THEN
  406.    IF item.offsReg # None THEN
  407.     DeRef( OPT.sysptrtyp, item );
  408.     adr.mode := areg;
  409.     adr.reg := OPL.GetAdrReg( );
  410.     OPL.Lea( item, adr.reg )
  411.    ELSE
  412.     adr.mode := item.mode;
  413.     adr.reg := item.reg;
  414.     adr.bd := item.bd;
  415.     adr.inxReg := None;
  416.     adr.offsReg := None
  417.    END
  418.   ELSE
  419.    adr.mode := item.mode;
  420.    adr.reg := item.reg;
  421.    adr.bd := item.bd + item.nolen * 4;
  422.    adr.inxReg := item.offsReg;
  423.    adr.xsize := item.xsize;
  424.    adr.scale := item.scale;
  425.    adr.offsReg := None;
  426.    adrReg.mode := areg;
  427.    adrReg.typ := OPT.sysptrtyp;
  428.    adrReg.reg := OPL.GetAdrReg( );
  429.    OPL.Lea( adr, adrReg.reg );
  430.    adr := adrReg
  431.   END; (* IF *)
  432.  END GetDynArrAdr;
  433.  PROCEDURE MakeField*( VAR item : OPL.Item; offset : LONGINT; typ : OPT.Struct );
  434.  (* Increments the address of item by offset and sets its type to typ. *)
  435.  BEGIN (* MakeField *)
  436.   OPL.LoadExternal( item );
  437.   INC( item.bd, offset );
  438.   item.typ := typ
  439.  END MakeField;
  440.  PROCEDURE MakeIndex*( VAR index, res : OPL.Item );
  441.  (* Makes an indexed item from an item and an index. res := res[ index ].
  442.   The generated item has always got an index register or an offset register. *)
  443.   VAR baseTyp : OPT.Struct;
  444.     sizeItem, chkItem, offset : OPL.Item;
  445.     size : LONGINT;
  446.     scale : INTEGER;
  447.  BEGIN (* MakeIndex *)
  448.   baseTyp := res.typ.BaseTyp;
  449.   size := baseTyp.size;
  450.   OPL.LoadExternal( res );
  451.   IF ( res.typ.comp # DynArr ) & ( index.mode = imm ) THEN
  452.    INC( res.bd, size * index.bd )
  453.   ELSE
  454.    ElimIndex( res );
  455.    IF index.typ.form = SInt  THEN Convert( index, OPT.inttyp ) END;
  456.    IF ( ( index.mode # imm ) OR ( index.bd # 0 ) ) & (indexCheck) THEN
  457.     IF res.typ.comp = DynArr THEN
  458.      MakeLen( res, res.typ.offset - res.typ.n, chkItem );
  459.      Convert( index, OPT.linttyp )
  460.     ELSE
  461.      MakeIntConst( res.typ.n - 1, index.typ, chkItem )
  462.     END; (* IF *)
  463.     OPL.Chk( index, chkItem );
  464.     (* OPL.FreeReg( chkItem ); *) (* Need this for CHK opti *)
  465.    END; (* IF *)
  466.    OPL.Load( index );
  467.    IF baseTyp.comp # Basic THEN
  468.     IF baseTyp.comp = DynArr THEN
  469.      Convert( index, OPT.linttyp );
  470.      BaseTypSize( res, sizeItem, scale );
  471.      OPL.Format12( MULS, sizeItem, index );
  472.      OPL.FreeReg( sizeItem )
  473.     ELSE
  474.      IF ( size = 1 ) OR ( size = 2 ) OR ( size = 4 ) OR ( size = 8 ) THEN
  475.       scale := SHORT( size )
  476.      ELSE
  477.       scale := 1;
  478.       MakeIntConst( size, index.typ, sizeItem );
  479.       IF index.typ.form = LInt THEN
  480.        OPL.Format12( MULS, sizeItem, index )
  481.       ELSE
  482.        OPL.Format11( MULS, sizeItem, index )
  483.       END; (* IF *)
  484.       OPL.FreeReg( sizeItem )
  485.      END; (* IF *)
  486.     END; (* IF *)
  487.     size := 1
  488.    ELSE scale := SHORT( size )
  489.    END; (* IF *)
  490.    IF baseTyp.comp = DynArr THEN
  491.     IF res.offsReg # None THEN
  492.      offset.mode := dreg;
  493.      offset.typ := OPT.linttyp;
  494.      offset.reg := res.offsReg;
  495.      OPL.Format2( ADD, offset, index )
  496.     END; (* IF *)
  497.     res.offsReg := index.reg
  498.    ELSE
  499.     IF res.typ.comp = DynArr THEN
  500.      GetDynArrVal( res );
  501.      ElimIndex( res )
  502.     END; (* IF *)
  503.     res.inxReg := index.reg
  504.    END; (* IF *)
  505.    IF index.typ.form = LInt THEN
  506.     res.xsize := 1
  507.    ELSE
  508.     res.xsize := 0
  509.    END; (* IF *)
  510.    CASE scale OF
  511.     1 : res.scale := 0
  512.     | 2 : res.scale := 1
  513.     | 4 : res.scale := 2
  514.     | 8 : res.scale := 3
  515.    END; (* CASE *)
  516.   END; (* IF *)
  517.   res.typ := baseTyp
  518.  END MakeIndex;
  519.  PROCEDURE MakeProc*( obj : OPT.Object; subcl : SHORTINT; VAR item : OPL.Item );
  520.  (* Makes an item from a procedure object. *)
  521.  BEGIN (* MakeProc *)
  522.   IF obj.mode = XProc THEN (* external procedure *)
  523.    item.mode := immL;
  524.    item.typ := OPT.sysptrtyp;
  525.    item.bd := SYSTEM.LSH( LONG( LONG( -obj.mnolev ) ), 8 ) + obj.adr;
  526.    item.offsReg := None
  527.   ELSIF obj.mode = TProc THEN
  528.    (* receiver is on top of the stack *)
  529.    IF obj.link.mode = VarPar THEN
  530.     item.mode := regx;
  531.     item.typ := OPT.sysptrtyp;
  532.     item.reg := SP.reg;
  533.     item.bd := 4;
  534.     item.inxReg := None;
  535.     item.offsReg := None
  536.    ELSE
  537.     item.mode := regx;
  538.     item.typ := OPT.sysptrtyp;
  539.     item.reg := SP.reg;
  540.     item.bd := 0;
  541.     item.inxReg := None;
  542.     item.offsReg := None;
  543.     DeRef( OPT.sysptrtyp, item );
  544.     item.bd := -4
  545.    END; (* IF *)
  546.    DeRef( OPT.sysptrtyp, item );
  547.    IF subcl = super THEN
  548.     item.bd := OPL.BaseTypeOffs + 4 * ( obj.link.typ.BaseTyp.extlev - 1 );
  549.     DeRef( OPT.sysptrtyp, item )
  550.    END; (* IF *)
  551.    item.bd := OPL.MethodOffs - 4 * ( obj.adr DIV 10000H + 1 )
  552.   ELSE
  553.    MakeIntConst( obj.linkadr, OPT.linttyp, item )
  554.   END; (* IF *)
  555.  END MakeProc;
  556.  PROCEDURE MakePostInc( typ : OPT.Struct; VAR item : OPL.Item );
  557.  (* Makes a post-increment item from the given item. *)
  558.   VAR dest : OPL.Item;
  559.  BEGIN (* MakePostInc *)
  560.   IF item.mode # postinc THEN
  561.    IF ( item.mode = regx ) & ( item.bd = 0 ) & ( item.inxReg = None ) & ~ ( item.reg IN { FP.reg, SP.reg } ) THEN
  562.     item.mode := postinc;
  563.     item.typ := typ
  564.    ELSE
  565.     dest.mode := postinc;
  566.     dest.typ := typ;
  567.     dest.reg := OPL.GetAdrReg( );
  568.     OPL.Lea( item, dest.reg );
  569.     item := dest
  570.    END
  571.   END
  572.  END MakePostInc;
  573.  PROCEDURE MakeSPPredec( VAR res : OPL.Item );
  574.  (* Makes a pre-decrement item with the stack pointer. *)
  575.  BEGIN (* MakeSPPredec *)
  576.   res.mode := predec;
  577.   res.reg := SP.reg;
  578.   res.typ := SP.typ
  579.  END MakeSPPredec;
  580.  PROCEDURE MakeCocItem*( trueCond : INTEGER; VAR res : OPL.Item );
  581.  (* Makes a coc item with the true-condition trueCond. *)
  582.  BEGIN (* MakeCocItem *)
  583.   res.mode := coc;
  584.   res.typ := OPT.booltyp;
  585.   res.bd := OPL.TFConds( trueCond );
  586.   (* leave tJump and fJump unchanged! *)
  587.  END MakeCocItem;
  588.  PROCEDURE MakeFCocItem*( trueCond : INTEGER; VAR res : OPL.Item );
  589.  (* Makes an fcoc item with the true-condition trueCond. *)
  590.  BEGIN (* MakeFCocItem *)
  591.   res.mode := fcoc;
  592.   res.typ := OPT.booltyp;
  593.   res.bd := OPL.TFFConds( trueCond );
  594.   (* leave tJump and fJump unchanged! *)
  595.  END MakeFCocItem;
  596.  PROCEDURE Swap( x : SET ) : INTEGER;
  597.  (* Writes bits 15 to 0 to the positions 0 to 15 of the result. Used for MOVEM. *)
  598.   VAR y : SET;
  599.     i : INTEGER;
  600.  BEGIN (* Swap *)
  601.   y := { };
  602.   FOR i := 0 TO 15 DO
  603.    IF i IN x THEN INCL( y, 15 - i ) END
  604.   END; (* FOR *)
  605.   RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
  606.  END Swap;
  607.  PROCEDURE SwappedFloats( x : SET ) : INTEGER;
  608.  (* Writes bits 23 to 16 to the positions 0 to 7 of the result. Used for FMOVEM. *)
  609.   VAR y : SET;
  610.     i : INTEGER;
  611.  BEGIN (* SwappedFloats *)
  612.   y := { };
  613.   FOR i := 16 TO 23 DO
  614.    IF i IN x THEN INCL( y, 23 - i ) END
  615.   END; (* FOR *)
  616.   RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
  617.  END SwappedFloats;
  618.  PROCEDURE Floats( x : SET ) : INTEGER;
  619.  (* Writes bits 16 to 23 to the positions 0 to 7 of the result. Used for FMOVEM. *)
  620.   VAR y : SET;
  621.     i : INTEGER;
  622.  BEGIN (* Floats *)
  623.   y := { };
  624.   FOR i := 16 TO 23 DO
  625.    IF i IN x THEN INCL( y, i - 16 ) END
  626.   END; (* FOR *)
  627.   RETURN SHORT( SYSTEM.VAL( LONGINT, y ) )
  628.  END Floats;
  629.  PROCEDURE PushRegs*( regs : SET );
  630.  (* Pushes the given registers onto the stack. *)
  631.   VAR sppredec : OPL.Item;
  632.     regList : INTEGER;
  633.  BEGIN (* PushRegs *)
  634.   MakeSPPredec( sppredec );
  635.   regList := Swap( regs );
  636.   IF regList # 0 THEN
  637.    OPL.Movem( 0, regList, sppredec )
  638.   END; (* IF *)
  639.   regList := Floats( regs );
  640.   IF regList # 0 THEN
  641.    OPL.FMovem( 0, regList , sppredec )
  642.   END; (* IF *)
  643.  END PushRegs;
  644.  PROCEDURE PopRegs*( regs : SET );
  645.  (* Pops the given registers from the stack. *)
  646.   VAR sppostinc : OPL.Item;
  647.     regList : INTEGER;
  648.  BEGIN (* PopRegs *)
  649.   sppostinc.mode := postinc;
  650.   sppostinc.reg := SP.reg;
  651.   sppostinc.typ := SP.typ;
  652.   regList := SwappedFloats( regs );
  653.   IF regList # 0 THEN
  654.    OPL.FMovem( 1, regList, sppostinc )
  655.   END; (* IF *)
  656.   regList := SHORT( SYSTEM.VAL( LONGINT, regs ) );
  657.   IF regList # 0 THEN
  658.    OPL.Movem( 1, regList, sppostinc )
  659.   END; (* IF *)
  660.  END PopRegs;
  661.  PROCEDURE TrueJump*( VAR expression : OPL.Item; VAR label : OPL.Label );
  662.  (* Generates a conditional branch to the given label with the true condition. *)
  663.  BEGIN (* TrueJump *)
  664.   IF expression.mode = imm THEN
  665.    IF expression.bd # 0  THEN
  666.     OPL.Jump( true, label )
  667.    END; (* IF *)
  668.   ELSIF expression.mode = coc THEN
  669.    OPL.Jump( SHORT( expression.bd DIV 10000H ), label )
  670.   ELSIF expression.mode = fcoc THEN
  671.    OPL.FJump( SHORT( expression.bd DIV 10000H ), label )
  672.   ELSE
  673.    OPL.Load( expression );
  674.    OPL.Format7( TST, expression );
  675.    OPL.Jump( NE, label )
  676.   END; (* IF *)
  677.   OPL.DefineLabel( expression.fJump )
  678.  END TrueJump;
  679.  PROCEDURE FalseJump*( VAR expression : OPL.Item; VAR label : OPL.Label );
  680.  (* Generates a conditional branch to the given label with the false condition. *)
  681.  BEGIN (* FalseJump *)
  682.   IF expression.mode = imm THEN
  683.    IF expression.bd = 0 THEN
  684.     OPL.Jump( true, label )
  685.    END; (* IF *)
  686.   ELSIF expression.mode = coc THEN
  687.    OPL.Jump( SHORT( expression.bd MOD 10000H ), label )
  688.   ELSIF expression.mode = fcoc THEN
  689.    OPL.FJump( SHORT( expression.bd MOD 10000H ), label )
  690.   ELSE
  691.    OPL.Load( expression );
  692.    OPL.Format7( TST, expression );
  693.    OPL.Jump( EQ, label )
  694.   END; (* IF *)
  695.   OPL.DefineLabel( expression.tJump )
  696.  END FalseJump;
  697.  PROCEDURE MoveBlock( scale : INTEGER; VAR size, source, dest : OPL.Item );
  698.  (* Moves a block of data of length size from source to dest. *)
  699.   VAR i : LONGINT;
  700.     losize : OPL.Item;
  701.     label : OPL.Label;
  702.  BEGIN (* MoveBlock *)
  703.   IF scale = 1 THEN
  704.    MakePostInc( OPT.sinttyp, source );
  705.    MakePostInc( OPT.sinttyp, dest )
  706.   ELSIF scale = 2 THEN
  707.    MakePostInc( OPT.inttyp, source );
  708.    MakePostInc( OPT.inttyp, dest )
  709.   ELSE
  710.    MakePostInc( OPT.linttyp, source );
  711.    MakePostInc( OPT.linttyp, dest )
  712.   END; (* IF *)
  713.   IF ( size.mode = imm ) & ( size.bd <= 6 ) THEN
  714.    i := 0;
  715.    WHILE i < size.bd DO
  716.     OPL.Move( source, dest );
  717.     INC( i )
  718.    END; (* WHILE *)
  719.   ELSE
  720.    IF size.mode = imm THEN
  721.     DEC( size.bd )
  722.    ELSE
  723.     OPL.Load( size );
  724.     OPL.Format1( SUBQ, 1, size )
  725.    END; (* IF *)
  726.    IF ( ( size.mode = imm ) & ( size.bd <= MAX( INTEGER ) ) ) OR ( size.typ # OPT.linttyp ) THEN
  727.     OPL.Load( size );
  728.     Convert( size, OPT.inttyp );
  729.     label := OPL.NewLabel;
  730.     OPL.DefineLabel( label );
  731.     OPL.Move( source, dest );
  732.     IF scale = 8 THEN OPL.Move( source, dest ) END;
  733.     OPL.DBcc( false, size.reg, label )
  734.    ELSE
  735.     OPL.Load( size );
  736.     losize.mode := dreg;
  737.     losize.typ := OPT.inttyp;
  738.     losize.reg := OPL.GetReg( );
  739.     OPL.Move( size, losize );
  740.     OPL.Swap( size );
  741.     label := OPL.NewLabel;
  742.     OPL.DefineLabel( label );
  743.     OPL.Move( source, dest );
  744.     IF scale = 8 THEN OPL.Move( source, dest ) END;
  745.     OPL.DBcc( false, losize.reg, label );
  746.     OPL.DBcc( false, size.reg, label )
  747.    END; (* IF *)
  748.   END; (* IF *)
  749.  END MoveBlock;
  750.  PROCEDURE Assign*( VAR source, dest : OPL.Item );
  751.  (* Generates code for the assignment dest := source.  *)
  752.   VAR size : LONGINT;
  753.     length, src : OPL.Item;
  754.     label : OPL.Label;
  755.     scale : INTEGER;
  756.  BEGIN (* Assign *)
  757.   Convert( source, dest.typ );
  758.   size := source.typ.size;
  759.   OPL.LoadAdr( dest );
  760.   IF source.mode = freg THEN
  761.    OPL.FMove( source, dest )
  762.   ELSIF source.typ.form = Real THEN
  763.    OPL.Move( source, dest )
  764.   ELSIF source.typ.form = LReal THEN
  765.    OPL.LoadAdr( source );
  766.    OPL.LoadExternal( source );
  767.    OPL.LoadExternal( dest );
  768.    source.typ := OPT.linttyp;
  769.    dest.typ := OPT.linttyp;
  770.    OPL.Move( source, dest );
  771.    INC( source.bd, 4 );
  772.    INC( dest.bd, 4 );
  773.    OPL.Move( source, dest );
  774.    DEC( dest.bd, 4 );
  775.    dest.typ := OPT.lrltyp
  776.   ELSIF source.mode IN { coc, fcoc } THEN
  777.    src.mode := imm;
  778.    src.typ := OPT.booltyp;
  779.    label := OPL.NewLabel;
  780.    IF source.mode = coc THEN
  781.     OPL.Jump( SHORT( source.bd MOD 10000H ), source.fJump )
  782.    ELSE
  783.     OPL.FJump( SHORT( source.bd MOD 10000H ), source.fJump )
  784.    END;
  785.    OPL.DefineLabel( source.tJump );
  786.    src.bd := 1;
  787.    OPL.Move( src, dest );
  788.    OPL.Jump( true, label );
  789.    OPL.DefineLabel( source.fJump );
  790.    src.bd := 0;
  791.    OPL.Move( src, dest );
  792.    OPL.DefineLabel( label )
  793.   ELSIF ( size = 1 ) OR ( size = 2 ) OR ( size = 4 ) THEN
  794.    OPL.Move( source, dest )
  795.   ELSE (* complex data structure *)
  796.    IF source.typ.comp = DynArr THEN
  797.     Size( source, length, scale );
  798.     GetDynArrVal( source )
  799.    ELSE
  800.     IF size MOD 4 = 0 THEN
  801.      scale := 4;
  802.      MakeIntConst( size DIV 4, OPT.linttyp, length )
  803.     ELSIF size MOD 2 = 0 THEN
  804.      scale := 2;
  805.      MakeIntConst( size DIV 2, OPT.linttyp, length )
  806.     ELSE
  807.      scale := 1;
  808.      MakeIntConst( size, OPT.linttyp, length )
  809.     END; (* IF *)
  810.    END; (* IF *)
  811.    MoveBlock( scale, length, source, dest )
  812.   END; (* IF *)
  813.  END Assign;
  814.  PROCEDURE MoveDynArrStack*( formalTyp : OPT.Struct; offset : LONGINT; VAR item : OPL.Item );
  815.  (* Moves the address and the length(s) of the given item to (offset, A7). *)
  816.   VAR source, dest, adr, length, len1 : OPL.Item;
  817.     typ : OPT.Struct;
  818.     i, dim : LONGINT;
  819.     lengthMade : BOOLEAN;
  820.  BEGIN (* MoveDynArrStack *)
  821.   dim := formalTyp.n + 1;
  822.   typ := item.typ;
  823.   dest.mode := regx;
  824.   dest.typ := OPT.linttyp;
  825.   dest.reg := SP.reg;
  826.   dest.bd := offset;
  827.   dest.inxReg := None;
  828.   IF typ.comp = DynArr THEN
  829.    source := item;
  830.    GetDynArrAdr( source, adr )
  831.   ELSE
  832.    adr.mode := areg;
  833.    adr.typ := OPT.sysptrtyp;
  834.    adr.reg := OPL.GetAdrReg( );
  835.    OPL.Lea( item, adr.reg )
  836.   END;
  837.   OPL.Move( adr, dest );
  838.   i := typ.offset - typ.n;
  839.   WHILE ( typ.comp = DynArr ) & ( dim > 1 ) DO
  840.    INC( dest.bd, 4 );
  841.    MakeLen( item, i, length );
  842.    OPL.Move( length, dest );
  843.    INC( i );
  844.    DEC( dim );
  845.    typ := typ.BaseTyp;
  846.    formalTyp := formalTyp.BaseTyp
  847.   END; (* WHILE *)
  848.   WHILE dim > 1 DO
  849.    INC( dest.bd, 4 );
  850.    IF typ.form = String THEN
  851.     MakeIntConst( item.nolen, OPT.linttyp, length )
  852.    ELSE
  853.     MakeIntConst( typ.n, OPT.linttyp, length )
  854.    END; (* IF *)
  855.    OPL.Move( length, dest );
  856.    INC( i );
  857.    DEC( dim );
  858.    typ := typ.BaseTyp;
  859.    formalTyp := formalTyp.BaseTyp
  860.   END; (* WHILE *)
  861.   IF ( formalTyp.comp = DynArr ) & ( formalTyp.BaseTyp = OPT.bytetyp ) THEN
  862.    IF typ.comp = DynArr THEN
  863.     lengthMade := TRUE;
  864.     MakeLen( item, i, length );
  865.     INC( i );
  866.     DEC( dim );
  867.     typ := typ.BaseTyp;
  868.     WHILE typ.comp = DynArr DO
  869.      MakeLen( item, i, len1 );
  870.      OPL.Format12( MULS, len1, length );
  871.      INC( i );
  872.      DEC( dim );
  873.      typ := typ.BaseTyp
  874.     END; (* WHILE *)
  875.    ELSE
  876.     lengthMade := FALSE
  877.    END; (* IF *)
  878.    IF typ.form = String THEN
  879.     MakeIntConst( item.nolen, OPT.linttyp, len1 )
  880.    ELSE
  881.     MakeIntConst( typ.size, OPT.linttyp, len1 )
  882.    END; (* IF *)
  883.    IF lengthMade THEN
  884.     IF len1.bd > 1 THEN OPL.Format12( MULS, len1, length ) END
  885.    ELSE
  886.     length := len1
  887.    END; (* IF *)
  888.   ELSIF typ.comp = DynArr THEN
  889.    MakeLen( item, i, length )
  890.   ELSIF typ.form = String THEN
  891.    MakeIntConst( item.nolen, OPT.linttyp, length )
  892.   ELSE
  893.    MakeIntConst( typ.n, OPT.linttyp, length )
  894.   END; (* IF *)
  895.   INC( dest.bd, 4 );
  896.   OPL.Move( length, dest )
  897.  END MoveDynArrStack;
  898.  PROCEDURE MoveAdrStack*( offset : LONGINT; VAR item : OPL.Item );
  899.  (* Moves the address of the given item to (offset, SP). *)
  900.   VAR dest, adrReg : OPL.Item;
  901.  BEGIN (* MoveAdrStack *)
  902.   dest.mode := regx;
  903.   dest.typ := OPT.sysptrtyp;
  904.   dest.reg := SP.reg;
  905.   dest.bd := offset;
  906.   dest.inxReg := None;
  907.   dest.offsReg := None;
  908.   adrReg.mode := areg;
  909.   adrReg.typ := OPT.sysptrtyp;
  910.   adrReg.reg := OPL.GetAdrReg( );
  911.   OPL.Lea( item, adrReg.reg );
  912.   OPL.Move( adrReg, dest )
  913.  END MoveAdrStack;
  914.  PROCEDURE MoveStack*( offset : LONGINT; VAR item : OPL.Item );
  915.  (* Moves the given item to (offset, SP). *)
  916.   VAR dest : OPL.Item;
  917.  BEGIN (* MoveStack *)
  918.   dest.mode := regx;
  919.   dest.typ := item.typ;
  920.   dest.reg := SP.reg;
  921.   dest.bd := offset;
  922.   dest.inxReg := None;
  923.   dest.offsReg := None;
  924.   Assign( item, dest )
  925.  END MoveStack;
  926.  PROCEDURE Copy*( VAR source, dest : OPL.Item );
  927.  (* Generates code for COPY( source, dest ). dest may not be bigger than 32kB. *)
  928.   VAR destlen : OPL.Item;
  929.     label : OPL.Label;
  930.     src, dst : OPL.Item;
  931.  BEGIN (* Copy *)
  932.   src := source;
  933.   dst := dest;
  934.   IF src.typ.comp = DynArr THEN
  935.    GetDynArrVal( src )
  936.   END; (* IF *)
  937.   IF dst.typ.comp = DynArr THEN
  938.    MakeLen( dst, 0, destlen );
  939.    GetDynArrVal( dst );
  940.    OPL.Load( destlen );
  941.    OPL.Format1( SUBQ, 2, destlen )
  942.   ELSE
  943.    MakeIntConst( dst.typ.n - 2, OPT.linttyp, destlen );
  944.    OPL.Load( destlen )
  945.   END; (* IF *)
  946.   MakePostInc( OPT.chartyp, src );
  947.   MakePostInc( OPT.chartyp, dst );
  948.   label := OPL.NewLabel;
  949.   OPL.DefineLabel( label );
  950.   OPL.Move( src, dst );
  951.   OPL.DBcc( EQ, destlen.reg, label );
  952.   MakeIntConst( 0, OPT.chartyp, src );
  953.   OPL.Move( src, dst )
  954.  END Copy;
  955.  PROCEDURE Decrement*( VAR designator, expression : OPL.Item );
  956.  (* Decrements the value of designator by expression *)
  957.  BEGIN (* Decrement *)
  958.   IF expression.mode = imm THEN
  959.    IF expression.bd >= 0 THEN        (*<<OJ*)
  960.     IF (expression.bd <= 8) & (designator.mode#pcx) THEN
  961.      OPL.Format1( SUBQ, SHORT( expression.bd ), designator )
  962.     ELSE
  963.      OPL.Format6( SUBI, expression.bd, designator )
  964.     END;
  965.    ELSE
  966.     IF (expression.bd >= -8) & (designator.mode#pcx) THEN
  967.      OPL.Format1( ADDQ, -SHORT( expression.bd ), designator )
  968.     ELSE
  969.      OPL.Format6( ADDI, -expression.bd, designator )
  970.     END;
  971.    END;
  972.   ELSE
  973.    OPL.Format2( SUB, expression, designator )
  974.   END; (* IF *)
  975.  END Decrement;
  976.  PROCEDURE Increment*( VAR designator, expression : OPL.Item );
  977.  (* Increments the value of designator by expression *)
  978.  BEGIN (* Increment *)
  979.   IF expression.mode = imm THEN
  980.    IF expression.bd >= 0 THEN        (*<<OJ*)
  981.     IF (expression.bd <= 8) & (designator.mode#pcx) THEN
  982.      OPL.Format1( ADDQ, SHORT( expression.bd ), designator )
  983.     ELSE
  984.      OPL.Format6( ADDI, expression.bd, designator )
  985.     END;
  986.    ELSE
  987.     IF (expression.bd >= -8) & (designator.mode#pcx) THEN
  988.      OPL.Format1( SUBQ, -SHORT( expression.bd ), designator )
  989.     ELSE
  990.      OPL.Format6( SUBI, -expression.bd, designator )
  991.     END;
  992.    END;
  993.   ELSE
  994.    OPL.Format2( ADD, expression, designator )
  995.   END; (* IF *)
  996.  END Increment;
  997.  PROCEDURE Include*( VAR set, element : OPL.Item );
  998.  (* set := set + { element } *)
  999.   VAR temp : OPL.Item;
  1000.  BEGIN (* Include *)
  1001.   temp := set;
  1002.   IF element.mode = imm THEN
  1003.    OPL.Format4( BSET, element.bd, temp )
  1004.   ELSE
  1005.    OPL.Format5( BSET, element, temp )
  1006.   END; (* IF *)
  1007.   OPL.Move( temp, set )
  1008.  END Include;
  1009.  PROCEDURE Exclude*( VAR set, element : OPL.Item );
  1010.  (* set := set - { element } *)
  1011.   VAR temp : OPL.Item;
  1012.  BEGIN (* Exclude *)
  1013.   temp := set;
  1014.   IF element.mode = imm THEN
  1015.    OPL.Format4( BCLR, element.bd, temp )
  1016.   ELSE
  1017.    OPL.Format5( BCLR, element, temp )
  1018.   END; (* IF *)
  1019.   OPL.Move( temp, set )
  1020.  END Exclude;
  1021.  PROCEDURE EnterMod*;
  1022.  (* Generates code for the entry into the module. *)
  1023.  BEGIN (* EnterMod *)
  1024.   OPL.SetEntry( 0, OPL.pc );
  1025.   OPL.Enter( 0 )
  1026.  END EnterMod;
  1027.  PROCEDURE CopyDynArrs( par : OPT.Object );
  1028.  (* Copys the dynamic arrays which are value-parameters to the stack. *)
  1029.   VAR source, dest, ptr, size, negsize, newSP : OPL.Item;
  1030.     scale : INTEGER;
  1031.  BEGIN (* CopyDynArrs *)
  1032.   WHILE par # NIL DO
  1033.    OPL.usedRegs := { };
  1034.    IF ( par.typ.comp = DynArr ) & ( par.mode = Var ) THEN
  1035.     MakeVar( par, source );
  1036.     Size( source, size, scale );
  1037.     OPL.Load( size );
  1038.     GetDynArrVal( source );
  1039.     IF scale = 1 THEN (* align size to 4 bytes *)
  1040.      OPL.Format1( ADDQ, 3, size );
  1041.      OPL.Format13( ASh, -2, size );
  1042.      scale := 4
  1043.     ELSIF scale = 2 THEN
  1044.      OPL.Format1( ADDQ, 1, size );
  1045.      OPL.Format13( ASh, -1, size );
  1046.      scale := 4
  1047.     END; (* IF *)
  1048.     negsize.mode := dreg;
  1049.     negsize.typ := OPT.linttyp;
  1050.     negsize.reg := OPL.GetReg( );
  1051.     OPL.Move( size, negsize );
  1052.     OPL.Format7( NEG, negsize );
  1053.     newSP.mode := regx;
  1054.     newSP.typ := OPT.sysptrtyp;
  1055.     newSP.reg := SP.reg;
  1056.     newSP.bd := 0;
  1057.     newSP.inxReg := negsize.reg;
  1058.     IF size.typ.form = LInt THEN newSP.xsize := 1 ELSE newSP.xsize := 0 END;
  1059.     newSP.scale := OPL.Scale( scale );
  1060.     OPL.Lea( newSP, SP.reg );
  1061.     dest.mode := areg;
  1062.     dest.typ := OPT.sysptrtyp;
  1063.     dest.reg := OPL.GetAdrReg( );
  1064.     OPL.Move( SP, dest );
  1065.     dest.mode := regx;
  1066.     dest.typ := par.typ;
  1067.     dest.bd := 0;
  1068.     dest.inxReg := None;
  1069.     MoveBlock( scale, size, source, dest );
  1070.     ptr.mode := regx;
  1071.     ptr.typ := OPT.sysptrtyp;
  1072.     ptr.reg := FP.reg;
  1073.     ptr.bd := par.adr;
  1074.     ptr.inxReg := None;
  1075.     OPL.Move( SP, ptr )
  1076.    END; (* IF *)
  1077.    par := par.link
  1078.   END; (* WHILE *)
  1079.  END CopyDynArrs;
  1080.  PROCEDURE EnterProc*( proc : OPT.Object );
  1081.  (* Generates code for the entry into a procedure. If ptrinit is set, the whole local variable area is initialized. *)
  1082.   VAR source, dest, losize, hisize, adrReg : OPL.Item;
  1083.     dsize, i : LONGINT;
  1084.     label : OPL.Label;
  1085.  BEGIN (* EnterProc *)
  1086.   OPL.DefineLabel( proc.linkadr );
  1087.   IF proc.adr # -1 THEN
  1088.    OPL.SetEntry( SHORT( proc.adr MOD 10000H ), OPL.pc )
  1089.   END; (* IF *)
  1090.   dsize := proc.conval.intval;
  1091.   OPL.Enter( -dsize );
  1092.   IF ptrinit THEN
  1093.    MakeIntConst( 0, OPT.linttyp, source );
  1094.    dest.mode := regx;
  1095.    dest.typ := OPT.linttyp;
  1096.    dest.reg := SP.reg;
  1097.    dest.bd := 0;
  1098.    dest.inxReg := None;
  1099.    dest.offsReg := None;
  1100.    IF dsize > 8 THEN   (* old was 24 *)
  1101.     adrReg.mode := areg;
  1102.     adrReg.typ := OPT.sysptrtyp;
  1103.     adrReg.reg := OPL.GetAdrReg( );
  1104.     OPL.Move( SP, adrReg );
  1105.     adrReg.mode := postinc;
  1106.     IF dsize > 20 THEN    (* if the constant is small, the code will be shorter, but slower; 20 is the shortest way *)
  1107.      IF dsize > 4 * MAX( INTEGER ) THEN
  1108.       MakeIntConst( ( dsize DIV 4 - 1 ) DIV 10000H, OPT.inttyp, hisize );
  1109.       OPL.Load( hisize );
  1110.       MakeIntConst( ( dsize DIV 4 - 1 ) MOD 10000H, OPT.inttyp, losize );
  1111.       OPL.Load( losize );
  1112.       label := OPL.NewLabel;
  1113.       OPL.DefineLabel( label );
  1114.       OPL.Move( source, adrReg );
  1115.       OPL.DBcc( false, losize.reg, label );
  1116.       OPL.DBcc( false, hisize.reg, label )
  1117.      ELSE
  1118.       MakeIntConst( dsize DIV 4 - 1, OPT.inttyp, losize );
  1119.       OPL.Load( losize );
  1120.       label := OPL.NewLabel;
  1121.       OPL.DefineLabel( label );
  1122.       OPL.Move( source, adrReg );
  1123.       OPL.DBcc( false, losize.reg, label )
  1124.      END; (* IF *)
  1125.     ELSE
  1126.      FOR i := 1 TO (dsize DIV 4) DO
  1127.       OPL.Move( source, adrReg )
  1128.      END
  1129.     END
  1130.    ELSE
  1131.     FOR i := 1 TO dsize DIV 4 DO
  1132.      OPL.Move( source, dest );
  1133.      INC( dest.bd, 4 )
  1134.     END; (* FOR *)
  1135.    END; (* IF *)
  1136.   END; (* IF *)
  1137.   CopyDynArrs( proc.link )
  1138.  END EnterProc;
  1139.  PROCEDURE Return*( proc : OPT.Object; withRes : BOOLEAN;  VAR result : OPL.Item );
  1140.  (* Generates code for returning from a procedure or a module (proc = NIL).
  1141.   result contains the value that has to be returned in D0 or FP0, if withRes is TRUE.
  1142.   D0 and FP0 can be used because all registers are free. *)
  1143.   VAR d0, fp0 : OPL.Item;
  1144.  BEGIN (* Return *)
  1145.   IF withRes THEN
  1146.    IF proc.typ.form IN RealSet THEN (* result is returned in FP0 *)
  1147.     IF ( result.mode # freg ) OR ( result.reg # 16 ) THEN
  1148.      fp0.mode := freg;
  1149.      fp0.reg := 16;
  1150.      fp0.typ := proc.typ;
  1151.      OPL.FMove( result, fp0 )
  1152.     END; (* IF *)
  1153.    ELSIF ( result.mode # dreg ) OR ( result.reg # 0 ) THEN
  1154.     d0.mode := dreg;
  1155.     d0.reg := 0;
  1156.     d0.typ := proc.typ;
  1157.     Assign( result, d0 ); (* Assign, not Move because of BOOLEAN return values. *)
  1158.    END; (* IF *)
  1159.   END; (* IF *)
  1160.   OPL.Return
  1161.  END Return;
  1162.  PROCEDURE WriteStaticLink*( obj : OPT.Object );
  1163.  (* Writes the static link of the given object to (A7) if necessary. *)
  1164.   VAR source, dest : OPL.Item;
  1165.     diff : INTEGER;
  1166.  BEGIN (* WriteStaticLink *)
  1167.   IF ( obj # NIL ) & ( obj.mnolev > 0 ) & ( obj.mode = LProc ) THEN (* static link needed *)
  1168.    diff := OPL.level - obj.mnolev;
  1169.    IF diff = 0 THEN (* local procedure *)
  1170.     source := FP
  1171.    ELSE
  1172.     source.mode := regx;
  1173.     source.typ := OPT.sysptrtyp;
  1174.     source.reg := FP.reg;
  1175.     source.bd := 8;
  1176.     source.inxReg := None;
  1177.     source.offsReg := None;
  1178.     IF diff > 1 THEN
  1179.      dest.mode := areg;
  1180.      dest.typ := OPT.sysptrtyp;
  1181.      dest.reg := OPL.GetAdrReg( );
  1182.      OPL.Move( source, dest );
  1183.      source.reg := dest.reg;
  1184.      WHILE diff > 2 DO
  1185.       OPL.Move( source, dest );
  1186.       DEC( diff )
  1187.      END; (* WHILE *)
  1188.     END; (* IF *)
  1189.    END; (* IF *)
  1190.    MoveStack( 0, source )
  1191.   END; (* IF *)
  1192.  END WriteStaticLink;
  1193.  PROCEDURE Call*( VAR item : OPL.Item; obj : OPT.Object );
  1194.  (* Calls the given procedure. *)
  1195.  BEGIN (* Call *)
  1196.   IF ( obj # NIL ) & ( obj.mode = CProc ) THEN
  1197.    OPL.WriteCProc( obj^.conval^.ext )
  1198.   ELSIF item.mode = imm THEN
  1199.    OPL.Bsr( item.bd );
  1200.    obj.linkadr := item.bd
  1201.   ELSE
  1202.    DeRef( OPT.sysptrtyp, item );
  1203.    OPL.Format15( JSR, item )
  1204.   END; (* IF *)
  1205.  END Call;
  1206.  PROCEDURE GetResult*( typ : OPT.Struct; VAR res : OPL.Item );
  1207.  (* Returns the result of a function call. *)
  1208.   VAR d0, fp0 : OPL.Item;
  1209.  BEGIN (* GetResult *)
  1210.   IF typ.form IN RealSet THEN
  1211.    IF 16 IN OPL.usedRegs THEN
  1212.     fp0.mode := freg;
  1213.     fp0.typ := typ;
  1214.     fp0.reg := 16;
  1215.     res.mode := freg;
  1216.     res.typ := typ;
  1217.     res.reg := OPL.GetFReg( );
  1218.     OPL.FMove( fp0, res )
  1219.    ELSE
  1220.     res.mode := freg;
  1221.     res.typ := typ;
  1222.     res.reg := 16;
  1223.     INCL( OPL.usedRegs, 16 )
  1224.    END; (* IF *)
  1225.   ELSIF 0 IN OPL.usedRegs THEN
  1226.    res.mode := dreg;
  1227.    res.typ := typ;
  1228.    res.reg := OPL.GetReg( );
  1229.    d0.mode := dreg;
  1230.    d0.typ := typ;
  1231.    d0.reg := 0;
  1232.    OPL.Move( d0, res )
  1233.   ELSE
  1234.    res.mode := dreg;
  1235.    res.typ := typ;
  1236.    res.reg := 0;
  1237.    INCL( OPL.usedRegs, 0 )
  1238.   END; (* IF *)
  1239.  END GetResult;
  1240.  PROCEDURE TypeTest*( VAR item : OPL.Item; typ : OPT.Struct; guard, equal : BOOLEAN );
  1241.  (* Generates code for a type test. If equal is true, the two types have to be equal, if guard is true, a Trap is generated
  1242.   if the test fails. If both are false, only the condition codes are set. *)
  1243.   VAR tag : OPL.Item;
  1244.     savedRegs : SET;
  1245.  BEGIN (* TypeTest *)
  1246.   savedRegs := OPL.usedRegs;
  1247.   IF ~ equal THEN
  1248.    DeRef( OPT.sysptrtyp, item );
  1249.    INC( item.bd, LONG( LONG( OPL.BaseTypeOffs + 4 * typ.extlev ) ) )
  1250.   END; (* IF *)
  1251.   OPL.Load( item );
  1252.   StaticTag( typ, tag );
  1253.   OPL.Cmp( tag, item );
  1254.   IF equal THEN
  1255.    OPL.Trapcc( NE, eqGuardTrap )
  1256.   ELSIF guard THEN
  1257.    OPL.Trapcc( NE, guardTrap )
  1258.   ELSE
  1259.    MakeCocItem( EQ, item )
  1260.   END; (* IF *)
  1261.   OPL.usedRegs := savedRegs;
  1262.  END TypeTest;
  1263.  PROCEDURE Case*( VAR expression : OPL.Item; lo, hi : LONGINT; VAR label : OPL.Label; VAR jtAdr : LONGINT );
  1264.  (* Generates the initializing part of a case statement and allocates the jump table.
  1265.   label denotes the else part of the case statement, jtAdr is the address of the jump table. *)
  1266.   VAR loItem, jumpTabEntry, jumpAddress : OPL.Item;
  1267.     jumpTab : ARRAY OPM.MaxCaseRange OF INTEGER;
  1268.  BEGIN (* Case *)
  1269.   OPL.Load( expression );
  1270.   IF expression.typ.form IN ByteSet THEN Convert( expression, OPT.inttyp ) END;
  1271.   MakeIntConst( lo, expression.typ, loItem );
  1272.   OPL.Format2( SUB, loItem, expression );
  1273.   OPL.Format6( CMPI, hi - lo, expression );
  1274.   OPL.Jump( HI, label );
  1275.   OPL.AllocBytes( jumpTab, 2 * ( hi - lo + 1 ), jtAdr );
  1276.   jumpTabEntry.mode := pcx;
  1277.   jumpTabEntry.typ := OPT.inttyp;
  1278.   jumpTabEntry.bd := jtAdr - OPL.ConstSize - OPL.dsize;
  1279.   jumpTabEntry.inxReg := expression.reg;
  1280.   IF expression.typ.size = 4 THEN
  1281.    jumpTabEntry.xsize := 1
  1282.   ELSE
  1283.    jumpTabEntry.xsize := 0;
  1284.    Convert( expression, OPT.inttyp )
  1285.   END; (* IF *)
  1286.   jumpTabEntry.scale := 1; (* 2 bytes *)
  1287.   OPL.Load( jumpTabEntry );
  1288.   jumpAddress.mode := pcx;
  1289.   jumpAddress.typ := OPT.sysptrtyp;
  1290.   jumpAddress.bd := 0;
  1291.   jumpAddress.inxReg := jumpTabEntry.reg;
  1292.   jumpAddress.xsize := 0; (* word *)
  1293.   jumpAddress.scale := 1; (* *2 *)
  1294.   OPL.Format15( JMP, jumpAddress )
  1295.  END Case;
  1296.  PROCEDURE AddToSP*( data : LONGINT );
  1297.  (* Subtracts the immediate value 'data' from the stack pointer. *)
  1298.  (* no ADDQ/SUBQ, new OPL does it in a better way *)
  1299.   VAR source : OPL.Item;
  1300.  BEGIN (* AddToSP *)
  1301.   IF data > 0 THEN
  1302.    (*IF data < 8 THEN
  1303.     OPL.Format1( ADDQ, SHORT( data ), SP )
  1304.    ELSE*)
  1305.     MakeIntConst( data, OPT.linttyp, source );
  1306.     OPL.Format3( ADD, source, SP.reg );
  1307.    (*END; (* IF *)*)
  1308.   ELSIF data < 0 THEN
  1309.    data := -data;
  1310.    (*IF data < 8 THEN
  1311.     OPL.Format1( SUBQ, SHORT( data ), SP )
  1312.    ELSE*)
  1313.     MakeIntConst( data, OPT.linttyp, source );
  1314.     OPL.Format3( SUB, source, SP.reg );
  1315.    (*END; (* IF *)*)
  1316.   END; (* IF *)
  1317.  END AddToSP;
  1318.  PROCEDURE Test*( VAR item : OPL.Item );
  1319.  (* Tests a boolean item and makes a coc item. fcoc items are left unchanged. *)
  1320.  BEGIN (* Test *)
  1321.   IF ( item.mode # coc ) & ( item.mode # fcoc ) THEN
  1322.    OPL.Load( item );
  1323.    OPL.Format7( TST, item );
  1324.    MakeCocItem( NE, item )
  1325.   END; (* IF *)
  1326.  END Test;
  1327.  PROCEDURE UpTo*( VAR low, high, res : OPL.Item );
  1328.  (* set constructor res := { low .. high }. *)
  1329.   VAR chkItem, leftShift, rightShift : OPL.Item;
  1330.  BEGIN (* UpTo *)
  1331.   res.mode := dreg;
  1332.   res.typ := OPT.settyp;
  1333.   res.reg := OPL.GetReg( );
  1334.   IF rangeCheck THEN
  1335.    MakeIntConst( OPM.MaxSet, high.typ, chkItem );
  1336.    IF low.mode # imm THEN OPL.Chk( low, chkItem ) END;
  1337.    IF high.mode # imm THEN OPL.Chk( high, chkItem ) END
  1338.   END; (* IF *)
  1339.   rightShift.mode := dreg;
  1340.   rightShift.typ := high.typ;
  1341.   rightShift.reg := OPL.GetReg( );
  1342.   leftShift.mode := dreg;
  1343.   leftShift.typ := high.typ;
  1344.   leftShift.reg := OPL.GetReg( );
  1345.   OPL.Moveq( OPM.MaxSet, rightShift.reg );
  1346.   OPL.Format2( SUB, high, rightShift );
  1347.   OPL.Move( rightShift, leftShift );
  1348.   OPL.Format2( ADD, low, leftShift );
  1349.   OPL.Moveq( -1, res.reg );
  1350.   OPL.Format14( LSh, 1, leftShift, res );
  1351.   OPL.Format14( LSh, 0, rightShift, res );
  1352.   OPL.FreeReg( high );
  1353.   OPL.FreeReg( low );
  1354.   OPL.FreeReg( leftShift );
  1355.   OPL.FreeReg( rightShift )
  1356.  END UpTo;
  1357.  PROCEDURE Abs*( VAR item : OPL.Item );
  1358.  (* Generates code for the calculation of the absolute value of the given item. *)
  1359.   VAR label : OPL.Label;
  1360.  BEGIN (* Abs *)
  1361.   IF item.typ.form IN RealSet THEN
  1362.    OPL.Format8( FABS, item, item )
  1363.   ELSE
  1364.    OPL.Load( item );
  1365.    label := OPL.NewLabel;
  1366.    OPL.Format7( TST, item );
  1367.    OPL.Jump( GE, label );
  1368.    OPL.Format7( NEG, item );
  1369.    OPL.DefineLabel( label )
  1370.   END; (* IF *)
  1371.  END Abs;
  1372.  PROCEDURE Adr*( VAR item : OPL.Item );
  1373.  (* Generates code for the calculation of the address of the given item. *)
  1374.   VAR reg : INTEGER;
  1375.     adr : OPL.Item;
  1376.  BEGIN (* Adr *)
  1377.   IF item.typ.comp = DynArr THEN
  1378.    GetDynArrAdr( item, adr );
  1379.    item := adr
  1380.   ELSIF item.mode IN { regx, pcx } THEN
  1381.     reg := OPL.GetAdrReg( );
  1382.     OPL.Lea( item, reg );
  1383.     item.reg := reg;
  1384.    item.mode := areg;
  1385.   ELSIF item.mode = abs THEN
  1386.    item.mode := immL
  1387.   ELSE
  1388.    HALT( 94 )
  1389.   END; (* IF *)
  1390.   item.typ := OPT.sysptrtyp
  1391.  END Adr;
  1392.  PROCEDURE Cap*( VAR item : OPL.Item );
  1393.  (* Generates code for the calculation of CAP( item ). For characters only. *)
  1394.  BEGIN (* Cap *)
  1395.   OPL.Load( item );
  1396.   OPL.Format4( BCLR, 5, item )
  1397.  END Cap;
  1398.  PROCEDURE Neg*( VAR item : OPL.Item );
  1399.  (* Generates code for the calculation of -item. *)
  1400.  BEGIN (* Neg *)
  1401.   IF item.typ.form IN RealSet THEN
  1402.    OPL.Format8( FNEG, item, item )
  1403.   ELSIF item.typ.form = Set THEN
  1404.    OPL.Load( item );
  1405.    OPL.Format7( NOT, item )
  1406.   ELSE
  1407.    OPL.Load( item );
  1408.    OPL.Format7( NEG, item )
  1409.   END; (* IF *)
  1410.  END Neg;
  1411.  PROCEDURE Not*( VAR item : OPL.Item );
  1412.  (* Generates code for the calculation of ~ item. For Booleans only. *)
  1413.   VAR tcond, fcond : LONGINT;
  1414.  BEGIN (* Not *)
  1415.   IF ( item.mode = coc ) OR ( item.mode = fcoc ) THEN
  1416.    tcond := item.bd DIV 10000H;
  1417.    fcond := item.bd MOD 10000H;
  1418.    item.bd := 10000H * fcond + tcond
  1419.   ELSE
  1420.    OPL.Load( item );
  1421.    OPL.Format7( TST, item );
  1422.    MakeCocItem( EQ, item )
  1423.   END; (* IF *)
  1424.  END Not;
  1425.  PROCEDURE Odd*( VAR item : OPL.Item );
  1426.  (* Generates code for the calculation of ODD( item ). *)
  1427.  BEGIN (* Odd *)
  1428.   OPL.Load( item );
  1429.   OPL.Format4( BTST, 0, item );
  1430.   MakeCocItem( NE, item )
  1431.  END Odd;
  1432.  PROCEDURE Plus*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1433.  (* Generates code for the addition dest := dest + source. *)
  1434.  BEGIN (* Plus *)
  1435.   OPL.AssertDestReg( typ, source, dest );
  1436.   IF typ.form = Set THEN
  1437.    OPL.Format2( oR, source, dest )
  1438.   ELSIF typ.form IN RealSet THEN
  1439.    OPL.Format8( FADD, source, dest )
  1440.   ELSE
  1441.    Increment(dest,source)        (*<<OJ*)
  1442.   END; (* IF *)
  1443.   OPL.FreeReg( source )
  1444.  END Plus;
  1445.  PROCEDURE Minus*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1446.  (* Generates code for the subtraktion dest := dest - source. *)
  1447.  BEGIN (* Minus *)
  1448.   IF typ.form = Set THEN
  1449.    OPL.Load( dest );
  1450.    OPL.Load( source );
  1451.    OPL.Format7( NOT, source );
  1452.    OPL.Format2( AND, source, dest )
  1453.   ELSIF typ.form IN RealSet THEN
  1454.    OPL.FLoad( dest );
  1455.    OPL.Format8( FSUB, source, dest )
  1456.   ELSE
  1457.    OPL.Load( dest );
  1458.    Decrement(dest,source)        (*<<OJ*)
  1459.   END; (* IF *)
  1460.   OPL.FreeReg( source )
  1461.  END Minus;
  1462.  PROCEDURE Mul*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1463.  (* Generates code for the multiplication dest := dest * source. *)
  1464.  BEGIN (* Mul *)
  1465.   OPL.AssertDestReg( typ, source, dest );
  1466.   IF typ.form = Set THEN
  1467.    OPL.Format2( AND, source, dest )
  1468.   ELSIF typ.form IN RealSet THEN
  1469.    OPL.Format8( FMUL, source, dest )
  1470.   ELSIF typ.form = SInt THEN
  1471.    Convert( source, OPT.inttyp );
  1472.    Convert( dest, OPT.inttyp );
  1473.    OPL.Format11( MULS, source, dest )
  1474.   ELSIF typ.form = Int THEN
  1475.    OPL.Format11( MULS, source, dest )
  1476.   ELSIF typ.form = LInt THEN
  1477.    Convert( source, OPT.linttyp );
  1478.    Convert( dest, OPT.linttyp );
  1479.    OPL.Format12( MULS, source, dest )
  1480.   END; (* IF *)
  1481.   OPL.FreeReg( source )
  1482.  END Mul;
  1483.  PROCEDURE Divide*( typ : OPT.Struct; VAR source, dest : OPL.Item );
  1484.  (* Generates code for the division dest := dest / source. *)
  1485.  BEGIN (* Divide *)
  1486.   IF typ.form = Set THEN
  1487.    OPL.Load( dest );
  1488.    OPL.Eor( source, dest )
  1489.   ELSE
  1490.    OPL.Format8( FDIV, source, dest )
  1491.   END; (* IF *)
  1492.   OPL.FreeReg( source )
  1493.  END Divide;
  1494.  PROCEDURE Div*( VAR source, dest : OPL.Item );
  1495.  (* Generates code for the integer division dest := dest DIV source. *)
  1496.   VAR label : OPL.Label;
  1497.     remainder : OPL.Item;
  1498.  BEGIN (* Div *)
  1499.   OPL.Load( dest );
  1500.   Convert( dest, OPT.linttyp );
  1501.   IF source.typ.form = LInt THEN
  1502.    remainder.mode := dreg;
  1503.    remainder.reg := OPL.GetReg( );
  1504.    remainder.typ := OPT.linttyp;
  1505.    OPL.Divsl( source, remainder, dest );
  1506.    OPL.Format4( BTST, 31, remainder )
  1507.   ELSE
  1508.    Convert( source, OPT.inttyp );
  1509.    OPL.Format11( DIVS, source, dest );
  1510.    OPL.Format4( BTST, 31, dest )
  1511.   END; (* IF *)
  1512.   label := OPL.NewLabel;
  1513.   OPL.Jump( EQ, label );
  1514.   OPL.Format1( SUBQ, 1, dest );
  1515.   OPL.DefineLabel( label );
  1516.   OPL.FreeReg( source )
  1517.  END Div;
  1518.  PROCEDURE Mod*( VAR source, dest : OPL.Item );
  1519.  (* Generates code for the remainder dest := dest MOD source.*)
  1520.   VAR label : OPL.Label;
  1521.     remainder : OPL.Item;
  1522.  BEGIN (* Mod *)
  1523.   OPL.Load( source ); (* because it is used twice and may be a pc-item. *)
  1524.   OPL.Load( dest );
  1525.   Convert( dest, OPT.linttyp );
  1526.   IF source.typ.form = LInt THEN
  1527.    remainder.mode := dreg;
  1528.    remainder.typ := OPT.linttyp;
  1529.    remainder.reg := OPL.GetReg( );
  1530.    OPL.Divsl( source, remainder, dest );
  1531.    dest := remainder;
  1532.    OPL.Format4( BTST, 31, dest )
  1533.   ELSE
  1534.    Convert( source, OPT.inttyp );
  1535.    OPL.Format11( DIVS, source, dest );
  1536.    OPL.Swap( dest );
  1537.    OPL.Format4( BTST, 15, dest )
  1538.   END; (* IF *)
  1539.   label := OPL.NewLabel;
  1540.   OPL.Jump( EQ, label );
  1541.   OPL.Format2( ADD, source, dest );
  1542.   OPL.DefineLabel( label );
  1543.   OPL.FreeReg( source )
  1544.  END Mod;
  1545.  PROCEDURE Mask*( mask : LONGINT; VAR dest : OPL.Item );
  1546.  (* Generates code for the calculation of dest := dest & ~mask. Used for MOD. *)
  1547.  BEGIN (* Mask *)
  1548.   OPL.Load( dest );
  1549.   OPL.Format6( ANDI, mask, dest )
  1550.  END Mask;
  1551.  PROCEDURE In*( VAR element, set, dest : OPL.Item );
  1552.  (* Generates code for the calculation of dest := element IN set. *)
  1553.  BEGIN (* In *)
  1554.   IF element.mode = imm THEN
  1555.    OPL.Format4( BTST, element.bd, set )
  1556.   ELSE
  1557.    OPL.Format5( BTST, element, set )
  1558.   END; (* IF *)
  1559.   MakeCocItem( NE, dest )
  1560.  END In;
  1561.  PROCEDURE LoadCC*( VAR item : OPL.Item );
  1562.  (* If item.mode is coc or fcoc, the item is loaded into a data register. *)
  1563.   VAR temp : OPL.Item;
  1564.  BEGIN (* LoadCC *)
  1565.   IF item.mode IN { coc, fcoc } THEN
  1566.    temp := item;
  1567.    item.mode := dreg;
  1568.    item.typ := OPT.booltyp;
  1569.    item.reg := OPL.GetReg( );
  1570.    Assign( temp, item )
  1571.   END; (* IF *)
  1572.  END LoadCC;
  1573.  PROCEDURE Compare*( kind : SHORTINT; VAR left, right, res : OPL.Item );
  1574.  (* Compares left and right and generates a coc- or fcoc-item. *)
  1575.   VAR tCond : INTEGER;
  1576.     dreg1, dreg2 : OPL.Item;
  1577.     begLabel, endLabel : OPL.Label;
  1578.  BEGIN (* Compare *)
  1579.   IF left.typ.form IN RealSet THEN
  1580.    OPL.Format8( FCMP, right, left );
  1581.    CASE kind OF
  1582.     eql : tCond := FEQ
  1583.     | neq : tCond := FNE
  1584.     | lss : tCond := FLT
  1585.     | leq : tCond := FLE
  1586.     | gtr : tCond := FGT
  1587.     | geq : tCond := FGE
  1588.    END; (* CASE *)
  1589.    MakeFCocItem( tCond, res )
  1590.   ELSE
  1591.    IF ( left.typ.comp IN { Array, DynArr } ) OR ( left.typ.form = String ) THEN
  1592.     IF left.typ.comp = DynArr THEN GetDynArrVal( left ) END;
  1593.     MakePostInc( OPT.chartyp, left );
  1594.     IF right.typ.comp = DynArr THEN GetDynArrVal( right ) END;
  1595.     MakePostInc( OPT.chartyp, right );
  1596.     dreg1.mode := dreg;
  1597.     dreg1.typ := OPT.chartyp;
  1598.     dreg1.reg := OPL.GetReg( );
  1599.     dreg2.mode := dreg;
  1600.     dreg2.typ := OPT.chartyp;
  1601.     dreg2.reg := OPL.GetReg( );
  1602.     begLabel := OPL.NewLabel;
  1603.     endLabel := OPL.NewLabel;
  1604.     OPL.DefineLabel( begLabel );
  1605.     OPL.Move( left, dreg1 );
  1606.     OPL.Move( right, dreg2 );
  1607.     OPL.Cmp( dreg2, dreg1 );
  1608.     OPL.Jump( NE, endLabel );
  1609.     OPL.Format7( TST, dreg1 );
  1610.     OPL.Jump( NE, begLabel );
  1611.     OPL.DefineLabel( endLabel );
  1612.     OPL.Cmp( dreg2, dreg1 )
  1613.    ELSE
  1614.     IF right.typ = OPT.niltyp THEN Convert( right, OPT.sysptrtyp ) END;
  1615.     LoadCC( left );
  1616.     LoadCC( right );
  1617.     OPL.Cmp( right, left )
  1618.    END; (* IF *)
  1619.    IF ( left.typ.form = Char ) OR ( left.typ.comp IN { Array, DynArr } ) OR ( left.typ.form = String ) THEN
  1620.     CASE kind OF
  1621.      eql : tCond := EQ
  1622.      | neq : tCond := NE
  1623.      | lss : tCond := CS
  1624.      | leq : tCond := LS
  1625.      | gtr : tCond := HI
  1626.      | geq : tCond := CC
  1627.     END; (* CASE *)
  1628.    ELSE
  1629.     CASE kind OF
  1630.      eql : tCond := EQ
  1631.      | neq : tCond := NE
  1632.      | lss : tCond := LT
  1633.      | leq : tCond := LE
  1634.      | gtr : tCond := GT
  1635.      | geq : tCond := GE
  1636.     END; (* CASE *)
  1637.    END; (* IF *)
  1638.    MakeCocItem( tCond, res )
  1639.   END; (* IF *)
  1640.  END Compare;
  1641.  PROCEDURE Shift*( opcode : INTEGER; VAR shift, dest : OPL.Item );
  1642.  (* Generates code for the calculation of ASH( dest, shift ), SYSTEM.LSH( dest, shift ) and SYSTEM.ROT( dest, shift ). *)
  1643.   VAR elseLabel, endLabel : OPL.Label;
  1644.  BEGIN (* Shift *)
  1645.   IF shift.mode = imm THEN
  1646.    IF shift.bd # 0 THEN
  1647.     IF ( shift.bd >= -8 ) & ( shift.bd <= 8 ) THEN
  1648.      OPL.Format13( opcode, SHORT( shift.bd ), dest )
  1649.     ELSE
  1650.      IF shift.bd < 0 THEN
  1651.       MakeIntConst( -shift.bd, OPT.inttyp, shift );
  1652.       OPL.Format14( opcode, 0, shift, dest )
  1653.      ELSE
  1654.       MakeIntConst( shift.bd, OPT.inttyp, shift );
  1655.       OPL.Format14( opcode, 1, shift, dest )
  1656.      END; (* IF *)
  1657.     END; (* IF *)
  1658.    END; (* IF *)
  1659.   ELSE (* shift must be tested, because the machine instructions only take positive shifts. *)
  1660.    elseLabel := OPL.NewLabel;
  1661.    endLabel := OPL.NewLabel;
  1662.    OPL.Load( shift );
  1663.    OPL.Load( dest );
  1664.    OPL.Format7( TST, shift );
  1665.    OPL.Jump( LT, elseLabel );
  1666.    OPL.Format14( opcode, 1, shift, dest );
  1667.    OPL.Jump( true, endLabel );
  1668.    OPL.DefineLabel( elseLabel );
  1669.    OPL.Format7( NEG, shift );
  1670.    OPL.Format14( opcode, 0, shift, dest );
  1671.    OPL.DefineLabel( endLabel )
  1672.   END; (* IF *)
  1673.  END Shift;
  1674.  PROCEDURE Trap*( nr : INTEGER );
  1675.  (* Generates code for a trap. *)
  1676.  BEGIN (* Trap *)
  1677.   OPL.Trapcc( true, nr )
  1678.  END Trap;
  1679.  PROCEDURE RunTime( nr : INTEGER );
  1680.  (* Calls the given run-time routine. *)
  1681.    VAR proc : OPL.Item;
  1682.  BEGIN (* RunTime *)
  1683.   proc.mode := abs;
  1684.   proc.typ := OPT.sysptrtyp;
  1685.   proc.bd := SYSTEM.LSH( LONG( 255 ), 8 ) + nr;
  1686.   OPL.Format15( JSR, proc )
  1687.  END RunTime;
  1688.  PROCEDURE PtrCheck( typ : OPT.Struct );
  1689.   VAR ptrTab : ARRAY 1 OF LONGINT;
  1690.     nofptrs : INTEGER;
  1691.  BEGIN (* PtrCheck *)
  1692.   nofptrs := 0;
  1693.   OPL.FindPtrs( typ, 0, ptrTab, nofptrs );
  1694.   IF nofptrs > 0 THEN OPM.err( -303 ) END
  1695.  END PtrCheck;
  1696.  PROCEDURE New*( VAR designator, tag : OPL.Item );
  1697.  (* Generates the code for calling NEW( designator ). *)
  1698.   VAR sppredec, res : OPL.Item;
  1699.     savedRegs : SET;
  1700.  BEGIN (* New *)
  1701.   savedRegs := OPL.usedRegs;
  1702.   PushRegs( savedRegs );
  1703.   MakeSPPredec( sppredec );
  1704.   OPL.Move( tag, sppredec );
  1705.   RunTime( 0 );
  1706.   AddToSP( 4 );
  1707.   GetResult( OPT.sysptrtyp, res );
  1708.   PopRegs( savedRegs );
  1709.   OPL.Move( res, designator )
  1710.  END New;
  1711.  PROCEDURE SYSNew*( VAR designator, size : OPL.Item );
  1712.  (* Generates the code for calling SYSTEM.NEW( designator, size ). *)
  1713.   VAR sppredec, res : OPL.Item;
  1714.     savedRegs : SET;
  1715.  BEGIN (* SYSNew *)
  1716.   PtrCheck( designator.typ.BaseTyp );
  1717.   savedRegs := OPL.usedRegs;
  1718.   PushRegs( savedRegs );
  1719.   MakeSPPredec( sppredec );
  1720.   Convert( size, OPT.linttyp );
  1721.   OPL.Move( size, sppredec );
  1722.   RunTime( 1 );
  1723.   AddToSP( 4 );
  1724.   GetResult( OPT.sysptrtyp, res );
  1725.   PopRegs( savedRegs );
  1726.   OPL.Move( res, designator )
  1727.  END SYSNew;
  1728.  PROCEDURE SYSMove*( VAR sourceAdr, destAdr, length : OPL.Item );
  1729.  (* Generates code for SYSTEM.MOVE( sourceAdr, destAdr, length ). *)
  1730.   VAR source, dest : OPL.Item;
  1731.  BEGIN (* SYSMove *)
  1732.   source.mode := areg;
  1733.   source.typ := OPT.linttyp;
  1734.   source.reg := OPL.GetAdrReg( );
  1735.   Convert( sourceAdr, OPT.linttyp );
  1736.   OPL.Move( sourceAdr, source );
  1737.   source.mode := postinc;
  1738.   source.typ := OPT.sinttyp;
  1739.   dest.mode := areg;
  1740.   dest.typ := OPT.linttyp;
  1741.   dest.reg := OPL.GetAdrReg( );
  1742.   Convert( destAdr, OPT.linttyp );
  1743.   OPL.Move( destAdr, dest );
  1744.   dest.mode := postinc;
  1745.   dest.typ := OPT.sinttyp;
  1746.   MoveBlock( 1, length, source, dest )
  1747.  END SYSMove;
  1748.  PROCEDURE SYSGet*( VAR adr, dest : OPL.Item );
  1749.  (* Generates code for SYSTEM.GET( adr, dest ). *)
  1750.   VAR adrReg : OPL.Item;
  1751.  BEGIN (* SYSGet *)
  1752.   adrReg.mode := areg;
  1753.   adrReg.typ := OPT.linttyp;
  1754.   adrReg.reg := OPL.GetAdrReg( );
  1755.   OPL.Move( adr, adrReg );
  1756.   adrReg.mode := regx;
  1757.   adrReg.bd := 0;
  1758.   adrReg.typ := dest.typ;
  1759.   adrReg.inxReg := None;
  1760.   Assign( adrReg, dest )
  1761.  END SYSGet;
  1762.  PROCEDURE SYSPut*( VAR source, address : OPL.Item );
  1763.  (* Generates code for SYSTEM.PUT( source, address ). *)
  1764.   VAR adrReg : OPL.Item;
  1765.  BEGIN (* SYSPut *)
  1766.   adrReg.mode := areg;
  1767.   adrReg.typ := OPT.linttyp;
  1768.   adrReg.reg := OPL.GetAdrReg( );
  1769.   address.typ := OPT.sysptrtyp;
  1770.   OPL.Move( address, adrReg );
  1771.   adrReg.mode := regx;
  1772.   adrReg.typ := source.typ;
  1773.   adrReg.bd := 0;
  1774.   adrReg.inxReg := None;
  1775.   Assign( source, adrReg )
  1776.  END SYSPut;
  1777.  PROCEDURE SYSGetReg*( VAR dest, sourceReg : OPL.Item );
  1778.  (* Generates code for SYSTEM.GETREG( sourceReg, dest ). *)
  1779.  BEGIN (* SYSGetReg *)
  1780.   sourceReg.reg := SHORT( sourceReg.bd );
  1781.   sourceReg.typ := dest.typ;
  1782.   IF ( sourceReg.bd >= 0 ) & ( sourceReg.bd <= 7 ) THEN
  1783.    sourceReg.mode := dreg;
  1784.    OPL.Move( sourceReg, dest )
  1785.   ELSIF ( sourceReg.bd >= 8 ) & ( sourceReg.bd <= 15 ) THEN
  1786.    sourceReg.mode := areg;
  1787.    OPL.Move( sourceReg, dest )
  1788.   ELSIF ( sourceReg.bd >= 16 ) & ( sourceReg.bd <= 23 ) THEN
  1789.    sourceReg.mode := freg;
  1790.    OPL.FMove( sourceReg, dest )
  1791.   ELSE
  1792.    OPM.err( 220 )
  1793.   END; (* IF *)
  1794.  END SYSGetReg;
  1795.  PROCEDURE SYSPutReg*( VAR source, destReg : OPL.Item );
  1796.  (* Generates code for SYSTEM.PUTREG( destReg, source ). *)
  1797.  BEGIN (* SYSPutReg *)
  1798.   destReg.reg := SHORT( destReg.bd );
  1799.   IF ( destReg.bd >= 0 ) & ( destReg.bd <= 7 ) THEN
  1800.    destReg.mode := dreg;
  1801.    OPL.Move( source, destReg )
  1802.   ELSIF ( destReg.bd >= 8 ) & ( destReg.bd <= 15 ) THEN
  1803.    destReg.mode := areg;
  1804.    OPL.Move( source, destReg )
  1805.   ELSIF ( destReg.bd >= 16 ) & ( destReg.bd <= 23 ) THEN
  1806.    destReg.mode := freg;
  1807.    OPL.FMove( source, destReg )
  1808.   ELSE
  1809.    OPM.err( 220 )
  1810.   END; (* IF *)
  1811.  END SYSPutReg;
  1812.  PROCEDURE SYSBit*( VAR adr, bitnr, res : OPL.Item );
  1813.  (* Generates code for SYSTEM.BIT( adr, bitnr ). *)
  1814.   VAR adrItem : OPL.Item;
  1815.  BEGIN (* SYSBit *)
  1816.   adrItem.mode := areg;
  1817.   adrItem.reg := OPL.GetAdrReg( );
  1818.   adrItem.typ := OPT.sysptrtyp;
  1819.   adr.typ := OPT.sysptrtyp;
  1820.   OPL.Move( adr, adrItem );
  1821.   adrItem.mode := regx;
  1822.   adrItem.bd := 0;
  1823.   adrItem.inxReg := None;
  1824.   IF bitnr.mode = imm THEN
  1825.    OPL.Format4( BTST, bitnr.bd, adrItem )
  1826.   ELSE
  1827.    OPL.Format5( BTST, bitnr, adrItem )
  1828.   END; (* IF *)
  1829.   MakeCocItem( NE, res )
  1830.  END SYSBit;
  1831.  PROCEDURE SYSCall*( VAR base, offset : OPL.Item );        (*<<OJ*)
  1832.  (* Generates code for SYSTEM.Call( base, offset ). *)
  1833.   VAR adrReg : OPL.Item;
  1834.  BEGIN (* SYSCall *)
  1835.   PushRegs({14});
  1836.   adrReg.mode := areg;
  1837.   adrReg.typ := OPT.linttyp;
  1838.   adrReg.reg := 14;
  1839.   OPL.Move( base, adrReg );
  1840.   adrReg.mode := regx;
  1841.   adrReg.inxReg := None;
  1842.   adrReg.typ := OPT.sysptrtyp;
  1843.   adrReg.bd := offset.bd;
  1844.   OPL.Format15( JSR, adrReg );
  1845.   PopRegs({14});
  1846.  END SYSCall;
  1847. BEGIN (* OPC *)
  1848.  FP.mode := areg;
  1849.  FP.typ := OPT.sysptrtyp;
  1850.  FP.reg := 14;
  1851.  SP.mode := areg;
  1852.  SP.typ := OPT.sysptrtyp;
  1853.  SP.reg := 15;
  1854.  saveRegs:=TRUE
  1855. END OPC.
  1856.